;;;;;;;;;;; Meta-evaluateur ;;;;;;;;;;;;;;
(load "compilateur-li.lisp")

;Meta-evalue une expression
(defun meval (expr)
  (eval-li (lisp2li expr ()) ()))

; Evalue des expressions du langage intermediaire
(defun eval-li (expr env)
  ; Si le car est un entier (taille de l'environnement)
  (if (integerp (car expr))
          (make-env-eval-li (car expr) () env)
  ; Sinon on teste les cas
  (ecase (car expr)
        (:lit (cdr expr))
        (:var (aref env (cdr expr)))
        (:if (if (eval-li (second expr) env)
                 (eval-li (third expr) env)
               (eval-li (fourth expr) env)))
        ;Fonction connue
        (:call (let ((ret (map-eval-li (cddr expr) env)))
                 (apply (second expr) (correctionBug ret))))

        ;Fonction deja definie (on est dans le corps d'une fonction)
        (:mcall (let ((fun (get (second expr) :defun)))
                  (eval-li (cdr fun) (make-env-eval-li (car fun) (cdr expr) env))))
        
        ;Cas du unknown
        (:unknown (let ((transf (lisp2li (second expr) (third expr))
                                (if (eq :unknown (car transf))
                                    (error "unknown ~s" expr)
                                  (progn (setf (car expr) (car transf))
                                         (setf (cdr expr) (cdr transf))
                                         (eval-li transf env)))))))
        
        ;Cas du progn
        (:progn (map-eval-li (cdr expr) env))
        ))
)

;Decoupe les listes a evaluer
(defun map-eval-li (lexpr env)
  (if (null lexpr)
      ()
    (cons (eval-li (car lexpr) env) (map-eval-li (cdr lexpr) env))))


;Construit l'environnement de l'evaluateur
(defun make-env-eval-li (taille args oenv)
  (map-eval-li-array (cdr args) oenv 1 (make-array taille)))


(defun map-eval-li-array (args oenv pos nenv)
  (if (null args)
      nenv
    (progn (setf (aref nenv pos) (eval-li (car args) oenv))
           (map-eval-li-array (cdr args) oenv (+ 1 pos) nenv))))

; ATTENTION : fonction de correction du bug introuvable sur le retour du map-eval-li
;             lors de la récupération des arguments dans le :call
(defun correctionBug (n)
  (if (atom n)
      ()
    ; Si le 1er est une liste
    (if (and (listp (car n)) (atom (car (car n))))
        (cons (car (car n)) (correctionBug (cdr n)))
      (cons (car n) (correctionBug (cdr n))))))
